home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / uim / ustr.scm < prev    next >
Encoding:
Text File  |  2010-11-07  |  9.3 KB  |  335 lines
  1. ;;; ustr.scm: logical order string of abstract elements
  2. ;;;
  3. ;;; Copyright (c) 2003-2009 uim Project http://code.google.com/p/uim/
  4. ;;;
  5. ;;; All rights reserved.
  6. ;;;
  7. ;;; Redistribution and use in source and binary forms, with or without
  8. ;;; modification, are permitted provided that the following conditions
  9. ;;; are met:
  10. ;;; 1. Redistributions of source code must retain the above copyright
  11. ;;;    notice, this list of conditions and the following disclaimer.
  12. ;;; 2. Redistributions in binary form must reproduce the above copyright
  13. ;;;    notice, this list of conditions and the following disclaimer in the
  14. ;;;    documentation and/or other materials provided with the distribution.
  15. ;;; 3. Neither the name of authors nor the names of its contributors
  16. ;;;    may be used to endorse or promote products derived from this software
  17. ;;;    without specific prior written permission.
  18. ;;;
  19. ;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND
  20. ;;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  21. ;;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  22. ;;; ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE
  23. ;;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  24. ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  25. ;;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  26. ;;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  27. ;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  28. ;;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  29. ;;; SUCH DAMAGE.
  30. ;;;;
  31.  
  32. ;; 'ustr' stands for 'universal (editable) string'. It represents a
  33. ;; logical order string of abstract elements for general
  34. ;; purpose. Since it does not assume any specific type of the
  35. ;; elements, we can reuse it against several generations of
  36. ;; composition table architectures such as rk or hk. It should be
  37. ;; isolated from composition table architecture to keep flexibility,
  38. ;; reusability and simplicity. ustr provides only basic string
  39. ;; operations.
  40. ;;
  41. ;; See test/test-ustr.scm to understand how it works.
  42.  
  43. (require "util.scm")
  44.  
  45. ;; ustr-former, ustr-set-former!, ustr-latter and ustr-set-latter! are
  46. ;; private accessors for use in ustr.scm. Users of ustr should use
  47. ;; ustr-former-seq, ustr-set-former-seq!, ustr-latter-seq and
  48. ;; ustr-set-latter-seq! instead.
  49. (define ustr-rec-spec
  50.   '((former ())  ;; reversed order
  51.     (latter ())))
  52. (define-record 'ustr ustr-rec-spec)
  53. (define ustr-new-internal ustr-new)
  54.  
  55. (define ustr-new
  56.   (lambda args
  57.     (let* ((former-seq (and (not (null? args))
  58.                 (car args)))
  59.        (latter-seq (and (not (null? (cdr args)))
  60.                 (cadr args)))
  61.        (ustr (ustr-new-internal)))
  62.       (and former-seq
  63.        (ustr-set-former-seq! ustr former-seq))
  64.       (and latter-seq
  65.        (ustr-set-latter-seq! ustr latter-seq))
  66.       ustr)))
  67.  
  68. (define ustr-whole-seq
  69.   (lambda (ustr)
  70.     (append-reverse (ustr-former ustr)
  71.             (ustr-latter ustr))))
  72.  
  73. (define ustr-former-seq
  74.   (lambda (ustr)
  75.     (reverse (ustr-former ustr))))
  76.  
  77. (define ustr-latter-seq ustr-latter)
  78.  
  79. (define ustr-set-whole-seq!
  80.   (lambda (ustr seq)
  81.     (ustr-clear-latter! ustr)
  82.     (ustr-set-former-seq! ustr seq)))
  83.  
  84. (define ustr-set-former-seq!
  85.   (lambda (ustr seq)
  86.     (ustr-set-former! ustr (reverse seq))))
  87.  
  88. (define ustr-set-latter-seq! ustr-set-latter!)
  89.  
  90. (define ustr-empty?
  91.   (lambda (ustr)
  92.     (and (null? (ustr-former ustr))
  93.      (null? (ustr-latter ustr)))))
  94.  
  95. (define ustr-clear!
  96.   (lambda (ustr)
  97.     (ustr-clear-former! ustr)
  98.     (ustr-clear-latter! ustr)))
  99.  
  100. (define ustr-clear-former!
  101.   (lambda (ustr)
  102.     (ustr-set-former! ustr ())))
  103.  
  104. (define ustr-clear-latter!
  105.   (lambda (ustr)
  106.     (ustr-set-latter! ustr ())))
  107.  
  108. (define ustr-copy!
  109.   (lambda (ustr other)
  110.     (ustr-set-former! ustr (ustr-former other))
  111.     (ustr-set-latter! ustr (ustr-latter other))))
  112.  
  113. ;; ignores cursor position
  114. (define ustr=
  115.   (lambda (elem= ustr other)
  116.     (and (= (ustr-length ustr)
  117.         (ustr-length other))
  118.      (every elem=
  119.         (ustr-whole-seq ustr)
  120.         (ustr-whole-seq other)))))
  121.  
  122. (define ustr-length
  123.   (lambda (ustr)
  124.     (+ (length (ustr-former ustr))
  125.        (length (ustr-latter ustr)))))
  126.  
  127. (define ustr-nth
  128.   (lambda (ustr n)
  129.     (car (ustr-ref ustr n))))
  130.  
  131. (define ustr-set-nth!
  132.   (lambda (ustr n elem)
  133.     (set-car! (ustr-ref ustr n)
  134.           elem)))
  135.  
  136. ;; private
  137. (define ustr-ref
  138.   (lambda (ustr n)
  139.     (let* ((former (ustr-former ustr))
  140.        (former-len (length former))
  141.        (whole-len (ustr-length ustr)))
  142.       (cond
  143.        ((or (< n 0)
  144.         (<= whole-len n)
  145.         (<= whole-len 0))
  146.     (error "out of range in ustr-ref"))
  147.        ((< n former-len)
  148.     (list-tail former
  149.            (- former-len n 1)))
  150.        (else
  151.     (list-tail (ustr-latter ustr)
  152.            (- n former-len)))))))
  153.  
  154. ;; sequence insertion regardless of cursor position
  155.  
  156. (define ustr-append!
  157.   (lambda (ustr seq)
  158.     (let* ((latter (ustr-latter ustr))
  159.        (new-latter (append latter seq)))
  160.       (ustr-set-latter! ustr new-latter))))
  161.  
  162. (define ustr-prepend!
  163.   (lambda (ustr seq)
  164.     (let* ((former (ustr-former ustr))
  165.        (new-former (append former (reverse seq))))
  166.       (ustr-set-former! ustr new-former))))
  167.  
  168. ;; mapping procedures
  169.  
  170. (define map-ustr-whole
  171.   (lambda (f ustr)
  172.     (let ((cons-map (lambda (kar kdr)
  173.               (cons (f kar) kdr)))
  174.       (former (ustr-former ustr))
  175.       (latter (ustr-latter ustr)))
  176.       (fold cons-map (map f latter) former))))
  177.  
  178. (define map-ustr-former
  179.   (lambda (f ustr)
  180.     (let ((cons-map (lambda (kar kdr)
  181.               (cons (f kar) kdr)))
  182.       (former (ustr-former ustr)))
  183.       (fold cons-map () former))))
  184.  
  185. (define map-ustr-latter
  186.   (lambda (f ustr)
  187.     (map f (ustr-latter ustr))))
  188.  
  189. (define append-map-ustr-whole
  190.   (lambda (f ustr)
  191.     (apply append (map-ustr-whole f ustr))))
  192.  
  193. (define append-map-ustr-former
  194.   (lambda (f ustr)
  195.     (apply append (map-ustr-former f ustr))))
  196.  
  197. (define append-map-ustr-latter
  198.   (lambda (f ustr)
  199.     (apply append (map-ustr-latter f ustr))))
  200.  
  201. ;; string generators which assumes string elements for convenience
  202.  
  203. (define string-append-map-ustr-whole
  204.   (lambda (f ustr)
  205.     (apply string-append (map-ustr-whole f ustr))))
  206.  
  207. (define string-append-map-ustr-former
  208.   (lambda (f ustr)
  209.     (apply string-append (map-ustr-former f ustr))))
  210.  
  211. (define string-append-map-ustr-latter
  212.   (lambda (f ustr)
  213.     (apply string-append (map-ustr-latter f ustr))))
  214.  
  215. ;; cursor moving
  216.  
  217. (define ustr-cursor-at-beginning?
  218.   (lambda (ustr)
  219.     (= (length (ustr-former ustr))
  220.        0)))
  221.  
  222. (define ustr-cursor-at-end?
  223.   (lambda (ustr)
  224.     (= (length (ustr-latter ustr))
  225.        0)))
  226.  
  227. (define ustr-cursor-pos
  228.   (lambda (ustr)
  229.     (length (ustr-former ustr))))
  230.  
  231. (define ustr-set-cursor-pos!
  232.   (lambda (ustr pos)
  233.     (if (and (>= pos 0)
  234.          (<= pos (ustr-length ustr)))
  235.     (let* ((whole (ustr-whole-seq ustr))
  236.            (latter (list-tail whole pos))
  237.            (former (take whole pos)))
  238.       (ustr-set-former-seq! ustr former)
  239.       (ustr-set-latter-seq! ustr latter)
  240.       #t)
  241.     #f)))
  242.  
  243. (define ustr-cursor-move!
  244.   (lambda (ustr offset)
  245.     (let* ((pos (ustr-cursor-pos ustr))
  246.        (new-pos (+ pos offset)))
  247.       (ustr-set-cursor-pos! ustr new-pos))))
  248.  
  249. (define ustr-cursor-move-backward!
  250.   (lambda (ustr)
  251.     (let ((former (ustr-former ustr)))
  252.       (if (not (null? former))
  253.       (let ((latter (ustr-latter ustr)))
  254.         (ustr-set-latter! ustr (cons (car former)
  255.                      latter))
  256.         (ustr-set-former! ustr (cdr former)))))))
  257.  
  258. (define ustr-cursor-move-forward!
  259.   (lambda (ustr)
  260.     (let ((latter (ustr-latter ustr)))
  261.       (if (not (null? latter))
  262.       (let ((former (ustr-former ustr)))
  263.         (ustr-set-former! ustr (cons (car latter)
  264.                      former))
  265.         (ustr-set-latter! ustr (cdr latter)))))))
  266.  
  267. (define ustr-cursor-move-beginning!
  268.   (lambda (ustr)
  269.     (ustr-set-latter! ustr (ustr-whole-seq ustr))
  270.     (ustr-clear-former! ustr)))
  271.  
  272. (define ustr-cursor-move-end!
  273.   (lambda (ustr)
  274.     (ustr-set-former! ustr (append-reverse (ustr-latter ustr)
  275.                        (ustr-former ustr)))
  276.     (ustr-clear-latter! ustr)))
  277.  
  278. ;; retrieve, remove and insert operations
  279.  
  280. ;; frontside element of cursor position
  281. (define ustr-cursor-frontside
  282.   (lambda (ustr)
  283.     (let ((latter (ustr-latter ustr)))
  284.       (if (not (null? latter))
  285.       (car latter)
  286.       (error "out of range in ustr-cursor-frontside")))))
  287.  
  288. ;; backside element of cursor position
  289. (define ustr-cursor-backside
  290.   (lambda (ustr)
  291.     (let ((former (ustr-former ustr)))
  292.       (if (not (null? former))
  293.       (car former)
  294.       (error "out of range in ustr-cursor-backside")))))
  295.  
  296. (define ustr-cursor-delete-frontside!
  297.   (lambda (ustr)
  298.     (let ((latter (ustr-latter ustr)))
  299.       (and (not (null? latter))
  300.        (ustr-set-latter! ustr (cdr latter))
  301.        #t))))
  302.  
  303. (define ustr-cursor-delete-backside!
  304.   (lambda (ustr)
  305.     (let ((former (ustr-former ustr)))
  306.       (and (not (null? former))
  307.        (ustr-set-former! ustr (cdr former))
  308.        #t))))
  309.  
  310. (define ustr-cursor-set-frontside!
  311.   (lambda (ustr elem)
  312.     (let ((latter (ustr-latter ustr)))
  313.       (and (not (null? latter))
  314.        (set-car! latter elem)
  315.        #t))))
  316.  
  317. (define ustr-cursor-set-backside!
  318.   (lambda (ustr elem)
  319.     (let ((former (ustr-former ustr)))
  320.       (and (not (null? former))
  321.        (set-car! former elem)
  322.        #t))))
  323.     
  324. (define ustr-insert-elem!
  325.   (lambda (ustr elem)
  326.     (ustr-set-former! ustr (cons elem
  327.                  (ustr-former ustr)))))
  328.  
  329. (define ustr-insert-seq!
  330.   (lambda (ustr seq)
  331.     (let* ((former (ustr-former ustr))
  332.        (new-former (append-reverse seq former)))
  333.       (ustr-set-former! ustr new-former))))
  334.  
  335.